perm filename GENPAT[1,LMM]1 blob
sn#031674 filedate 1973-03-25 generic text, type T, neo UTF8
(PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ")
T)
(LISPXPRIN1 (QUOTE "25-MAR-73 06:22:06")
T)
(LISPXTERPRI T))
(LISPXPRINT (QUOTE GENPATVARS)
T)
(RPAQQ GENPATVARS
((FNS PICK RAND1 ORR PAT PATELT EXPRESSION VAR GENPAT XLATE
LISTOF NUMBER FNNAME TSTPARSE DIFFER PATELT1 PATELT2
PATELT3 PRED PATELT4 TMPPATELT UNPARSE UNPARSELT PACKRAT
PACKRAT1)
(VARS)
(PROP MACRO ORR LISTOF)
(ADVICE PATELT)))
(DEFINEQ
(PICK
[LAMBDA (L)
(CAR (NTH L (RAND1 (LENGTH L])
(RAND1
[LAMBDA (N)
(XLATE (RAND 0.0 1.0)
N])
(ORR
[NLAMBDA L
(EVAL (PICK L])
(PAT
[LAMBDA NIL (* A pattern is a list
of at least one PATELT)
(LISTOF (PATELT)
1])
(PATELT
[LAMBDA NIL
(ORR (PATELT1)
(PATELT2)
(PATELT3)
[CONS (QUOTE ←)
(CONS (VAR)
(ORR (PATELT2)
(PATELT3]
(CONS (QUOTE ->)
(CONS (EXPRESSION)
(ORR (PATELT2)
(PATELT3)))
(* This is input as (... PATELT ← EXPRESSION ..) and
parses this way -
Depends, on input, on whether the first thing can
PARSE as a pattern or not)
)
(CONS (QUOTE !)
(ORR (PATELT1)
(PATELT3)
(CONS (QUOTE ←)
(CONS (VAR)
(PATELT3)))
(CONS (QUOTE ->)
(CONS (EXPRESSION)
(PATELT3])
(EXPRESSION
[LAMBDA (FLG)
(ORR (COND
(FLG NIL)
(T (VAR)))
(ORR (NUMBER)
(VAR))
(CONS (SETQ FLG (FNNAME))
(COND
((SUBRP FLG)
(LIST (EXPRESSION)))
((GETD FLG)
(PROG ((X 1)
LST
(MAX (NARGS FLG)))
LP [COND
((IGREATERP X MAX)
(RETURN LST))
(T (SETQ LST (NCONC1 LST (EXPRESSION]
(SETQ X (ADD1 X))
(GO LP)))
(T (LISTOF (EXPRESSION)
0 3])
(VAR
[LAMBDA NIL
(PICK (QUOTE (TUGGLE TICKLE TAG TUMMY TISKET TASKET TRISKET TRASKET
TOOKEY TACKEY EGG BASKET HEAD TAIL FOO BAZ
FIDDLE TURKEY TEM TMP LST EXPR1 STRUC SILLY
SALLY LARRY ME SRI WARREN BOB BILL FRED
SHIRLEY TERESA CAROLYNN SUSAN BARBARA MADELYN
MARY TED BILL BOB CAROL ALICE FRANK LES NANCY
VICKI XEROX])
(GENPAT
[LAMBDA (STARDONE)
(PROG (VAL)
(PRINTDEF (SETQ VAL (PAT)))
(TERPRI)
(RETURN VAL])
(XLATE
[LAMBDA (N1 N2)
(ADD1 (FTIMES N2 (EXPT (FDIFFERENCE N1 1.0)
2])
(LISTOF
[NLAMBDA (EXPR MIN MAX)
(PROG (VAL (MIN (OR (EVAL MIN)
0))
(MAX (OR (EVAL MAX)
10)))
(RPTQ (IPLUS MIN (RAND1 (IDIFFERENCE MAX MIN)))
(SETQ VAL (CONS (EVAL EXPR)
VAL)))
(RETURN VAL])
(NUMBER
[LAMBDA NIL
(RAND 2 10])
(FNNAME
[LAMBDA NIL
(PICK (QUOTE (NUMBERP GETD EXPRP ATOM LITATOM STRINGP FIXP NNIL
ZEROP INFILEP LISTP NLISTP MINUSP SMALLP])
(TSTPARSE
[LAMBDA NIL
(SETQ PAT1 (GENPAT))
(PRINT (SETQ PAT2 (UNPARSE PAT1)))
[PRINT (SETQ PAT3 (PARSE (COPY PAT2]
(COND
((NOT (SETQ DIFF (DIFFER PAT1 PAT3)))
(QUOTE WIN!))
(T (QUOTE LOSE!!])
(DIFFER
[LAMBDA (L1 L2)
(COND
((OR (NLISTP L1)
(NLISTP L2))
(AND (NOT (EQUAL L1 L2))
(OR L2 L1)))
(T (PROG [(CAR (DIFFER (CAR L1)
(CAR L2)))
(CDR (DIFFER (CDR L1)
(CDR L2]
(RETURN (OR (AND CAR CDR (CONS CAR CDR))
CAR CDR])
(PATELT1
[LAMBDA NIL
(COND
(STARDONE (CONS (QUOTE DEFAULT)
(VAR)))
(T (OR (CONS (QUOTE DEFAULT)
(VAR))
(PROG1 (QUOTE *)
(SETQ STARDONE T])
(PATELT2
[LAMBDA NIL
(ORR (QUOTE $)
(QUOTE $1)
(CONS (QUOTE $$)
(ORR (NUMBER)
(EXPRESSION])
(PATELT3
[LAMBDA NIL
(ORR (CONS (QUOTE :)
(PRED))
(PAT])
(PRED
[LAMBDA NIL
(ORR (LIST (CAR (FNTH (QUOTE (EQ EQUAL))
(RAND 1 2)))
(QUOTE X)
(ORR (KWOTE (EXPRESSION))
(EXPRESSION)))
(FNNAME)
(LIST (FNNAME)
(QUOTE X])
(PATELT4
[LAMBDA NIL
(ORR (PATELT3)
(CONS (QUOTE ←)
(CONS (VAR)
(PATELT3)))
(CONS (QUOTE ->)
(CONS (EXPRESSION)
(PATELT3])
(TMPPATELT
[LAMBDA NIL
(ORR (PATELT1)
(PATELT2)
(PATELT3)
[CONS (QUOTE ←)
(CONS (VAR)
(ORR (QUOTE $1)
(PATELT3]
(CONS (QUOTE ->)
(CONS (EXPRESSION)
(ORR (QUOTE $1)
(PATELT3)))
(* This is input as (... PATELT ← EXPRESSION ..) and
parses this way -
Depends, on input, on whether the first thing can
PARSE as a pattern or not)
])
(UNPARSE
[LAMBDA (PAT) (* Unpatparse each
pattern element and
NCONC values together)
(MAPCONC PAT (FUNCTION UNPATPARSELT])
(UNPARSELT
[LAMBDA (PATELT) (* CREATE valid input
sytax)
(PROG (TEM)
(COND
((NLISTP PATELT)
(SELECTQ PATELT
(($1 $ *)
(LIST PATELT))
(HELP (QUOTE "CAN'T UNPATPARSE")
PATELT)))
(T
(SELECTQ
(CAR PATELT)
(DEFAULT (LIST (CDR PATELT)))
[$$ (COND
((NUMBERP (CDR PAT))
(PACKRAT (QUOTE $)
(CDR PATELT)))
((NLISTP (CDR PATELT))
(PACKRAT (QUOTE $$)
(CDR PATELT)))
(T (LIST (CAR PATELT)
(CDR PATELT]
[:(COND
((NLISTP (CDR PATELT))
(PACKRAT (QUOTE :)
(CDR PATELT)))
((NOT (EQ (CADDR PATELT)
(QUOTE X)))
(LIST (QUOTE :)
(CDR PATELT)))
[(EQ (CADR PATELT)
(QUOTE EQ))
(COND
[(EQ (CAR (CADDDR PATELT))
(QUOTE QUOTE))
(PACKRAT (QUOTE ')
(CADR (CADDDR PATELT]
(T (PACKRAT (QUOTE ==)
(CADR (CADDDR PATELT]
[(EQ (CADR PATELT)
(QUOTE EQUAL))
(COND
[(EQ (CAR (CADDDR PATELT))
(QUOTE QUOTE))
(PACKRAT (QUOTE ')
(CADR (CADDDR PATELT]
(T (PACKRAT (QUOTE =)
(CADR (CADDDR PATELT]
((NOT (CDDDR PATELT))
(PACKRAT (QUOTE :)
(CADR PATELT)))
(T (PACKRAT ':(CDR PATELT]
[ANY (LIST (CONS (CAR PATELT)
(UNPATPARSE (CDR PATELT]
(←(NCONC [PACKRAT (CADR PATELT)
(CAR PATELT)
(CAR (SETQ TEM (UNPATPARSELT
(CDDR PATELT]
(CDR TEM)))
(-> (PACKRAT (UNPATPARSELT (CDDR PATELT))
(QUOTE ←)
(CADR PATELT)))
(! (NCONC [PACKRAT (QUOTE !)
(CAR (SETQ TEM (UNPATPARSELT
(CDR PATELT]
(CDR TEM)))
(LIST (UNPATPARSE PATELT])
(PACKRAT
[LAMBDA N
(PROG ((CNT N)
VAL ATLST)
LP (COND
((ZEROP CNT)
(RETURN (PACKRAT1 ATLST VAL)))
((NLISTP (ARG N CNT))
(SETQ ATLST (CONS (ARG N CNT)
ATLST)))
(T (SETQ VAL (CONS (ARG N CNT)
(PACKRAT1 ATLST VAL)))
(SETQ ATLST)))
(SETQ CNT (SUB1 CNT))
(GO LP])
(PACKRAT1
[LAMBDA (ATLST LST)
(COND
(ATLST (CONS (PACK ATLST)
LST))
(T LST])
)
(DEFLIST(QUOTE(
[ORR
(L (PROG ((TEM 0))
(CONS (QUOTE SELECTQ)
(CONS (LIST (QUOTE RAND1)
(LENGTH L))
(NCONC [MAPCAR L (FUNCTION
(LAMBDA
(X)
(LIST (SETQ TEM
(ADD1 TEM))
X]
(QUOTE ((HELP]
[LISTOF
(L ([LAMBDA
(EXPR MIN MAX)
(LIST (QUOTE PROG)
(QUOTE (VAL))
(LIST (QUOTE RPTQ)
[COND [MIN (LIST (QUOTE IPLUS)
MIN
(LIST (QUOTE RAND1)
(LIST (QUOTE IDIFFERENCE)
(OR MAX 10)
MIN]
(T (LIST (QUOTE RAND1)
(OR MAX 10]
(LIST (QUOTE SETQ)
(QUOTE VAL)
(CONS (QUOTE CONS)
(CONS EXPR (QUOTE (VAL]
(CAR L)
(CADR L)
(CADDR L]
))(QUOTE MACRO))
(DEFLIST(QUOTE(
[PATELT (NIL (BEFORE NIL (RETURN (TMPPATELT]
))(QUOTE READVICE))
STOP